home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / DEMO / EXCDEMO.M < prev    next >
Encoding:
Text File  |  1990-12-12  |  2.1 KB  |  75 lines
  1. MODULE ExcDemo;
  2.  
  3. (*
  4.  * Dieses Programm demonstriert, wie Modula-Funktionen in Exception-
  5.  * Vektoren installiert werden können.
  6.  *
  7.  * Hier wird die Prozedur 'vbl' im Interrupt-Vektor (Level 4) installiert.
  8.  * Somit wird sie ca. 50-70 Mal pro Minute aufgerufen. Die Funktion läßt
  9.  * zur Kontrolle ein kleines Lauflicht oben links auf dem Bildschirm er-
  10.  * scheinen.
  11.  *
  12.  * Wird das Modul unter der Shell gestartet, kann es beim Beenden der Shell
  13.  * oder durch wiederholten Start wieder freigegeben werden.
  14.  *
  15.  * Achtung:
  16.  *   Das Modul darf nicht vollständig optimiert werden, wenn es gelinkt
  17.  *   werden soll. Vielmehr ist die mittlere Optimierung zu wählen, damit
  18.  *   die Link-Informationen zum Residentmachen des Programms erhalten
  19.  *   bleiben.
  20.  *)
  21.  
  22. FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, BYTE, WORD, LONGWORD;
  23. FROM ModCtrl IMPORT FirstModuleStart, ReleaseModule, InstallModule;
  24. FROM MOSGlobals IMPORT MemArea;
  25. FROM SysTypes IMPORT ExcSet, ExcDesc, IRLevel4;
  26. FROM Excepts IMPORT DeInstallExc, SysInstallPreExc;
  27. FROM XBIOS IMPORT ScreenLogicalBase;
  28.  
  29. VAR bp, oldv, hdl: ADDRESS;
  30.     ok: BOOLEAN;
  31.     st: ARRAY [1..1000] OF CARDINAL;
  32.     cnt, c2, i,a:CARDINAL;
  33.     p: POINTER TO ARRAY [0..399] OF ARRAY [0..39] OF BITSET;
  34.     vblwsp, termwsp: MemArea;
  35.  
  36.  
  37. PROCEDURE term;
  38.   BEGIN
  39.     DeInstallExc (hdl);
  40.     ReleaseModule;
  41.   END term;
  42.  
  43. PROCEDURE vbl (VAR x: ExcDesc): BOOLEAN;
  44.   (*$R- keine Püfungen, damit es etwas schneller geht *)
  45.   VAR b: BITSET;
  46.   BEGIN
  47.     INC (cnt);
  48.     IF cnt > 3 THEN
  49.       cnt:= 0;
  50.       b:= {};
  51.       INCL (b, a);
  52.       IF a=0 THEN a:= 15; ELSE DEC (a) END;
  53.       p^[0,0]:= b;
  54.       p^[1,0]:= b;
  55.       p^[2,0]:= b;
  56.       p^[3,0]:= b;
  57.     END;
  58.     RETURN TRUE
  59.   END vbl;
  60.   (*$R=*)
  61.  
  62. BEGIN
  63.   IF FirstModuleStart () THEN
  64.     p:= ScreenLogicalBase ();
  65.     vblwsp.bottom:= ADR (st);
  66.     vblwsp.length:= SIZE (st);
  67.     SysInstallPreExc (ExcSet {IRLevel4}, vbl, FALSE, vblwsp, hdl);
  68.     IF hdl # NIL THEN
  69.       InstallModule (term, termwsp);  (* Modul resident machen *)
  70.     END
  71.   ELSE
  72.     term
  73.   END
  74. END ExcDemo.
  75.